Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/edgetext/clsdate_.cl_/clsdate_.cl

Text File | 1998-03-21 | 52.9 KB | 1,420 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
End
Attribute VB_Name = "clsDate_range"
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'**************************************************************************************
'Title:     clsDate_range.cls
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This class allows single record access to the Date_range Table
'Properties:Equate to the fields in the table
'Methods:   Allow for record manipulation


'It is recommended that the Database object Dbtimesheet be declared global

'It is also recommended that the Configuration object be declared global if it is being used
'This is so that it can be persistent
'**************************************************************************************

'Here are the Field Properties for this table Class
Public Date_Id as Long
Public Starting_Date as String
Public Ending_Date as String
Public Updated_By as String
Public Update_Module as String
Public Update_Time as String

'These are the ScratchPad Variables
Private mDate_Id as Long
Private mStarting_Date as String
Private mEnding_Date as String
Private mUpdated_By as String
Private mUpdate_Module as String
Private mUpdate_Time as String

'This public variable tells whether a function was successful, it is True when a function
'is successful, and false when a function is unsuccessful
Public Success as Boolean
'This is the Error Code which was generated in the function call, it matches Err from VB
Public ErrorCode as Double
'This is the Error message which was generated in the function call, it matches Errors(0) VB
Public ErrorMessage as String
'This Constant tells the error traps how many retries to perform
Private Const MaxRetries = 4

'********************************************************************************************************
'Title:     CreateTable
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This subroutine Creates the very table that this class was created to read and write
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public Sub CreateTable()

Dim lsCreate as string
Dim RetCode as integer, liCount as integer, BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeCreateTable
    End If


    'Assemble the SQL String
    lsCreate = "Create Table DATE_RANGE ("
    lsCreate = lsCreate & "Date_Id Long(4),"
    lsCreate = lsCreate & "Starting_Date Date/Time(8),"
    lsCreate = lsCreate & "Ending_Date Date/Time(8),"
    lsCreate = lsCreate & "Updated_By String(50),"
    lsCreate = lsCreate & "Update_Module String(50),"
    lsCreate = lsCreate & "Update_Time Date/Time(8))"

    'Execute the SQL
    Dbtimesheet.Execute lsCreate
    On Error GoTo 0
    Exit Sub

NoDate_rangeCreateTable:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeCreateTableConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.CreateTable"
        If Err = 3146 then
            objError.Message = "Date_range, CreateTable " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, CreateTable "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsCreate
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeCreateTableConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     AddItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method Adds Items to the Database after the Key properties
'           of the class have been filled
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public Sub AddItem()

Dim lsAdd as string
Dim RetCode as integer, liCount as integer, BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeAddItem
    End If

    'First we assign all the properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes

    'Assemble the SQL String
    lsAdd = "Insert into DATE_RANGE ("
    'First the Field List
    lsAdd = lsAdd & "Date_Id,"
    lsAdd = lsAdd & "Starting_Date,"
    lsAdd = lsAdd & "Ending_Date,"
    lsAdd = lsAdd & "Updated_By,"
    lsAdd = lsAdd & "Update_Module,"
    lsAdd = lsAdd & "Update_Time)"
    lsAdd = lsAdd & " Values("
    'Now the Value List
    lsAdd = lsAdd & "" & Format(Date_Id) & ","
    lsAdd = lsAdd & "" & Starting_Date & ","
    lsAdd = lsAdd & "" & Ending_Date & ","
    'These are the Audit Trail Fields
    lsAdd = lsAdd & "'" & objConfiguration.LanId & "',"
    lsAdd = lsAdd & "'" & objConfiguration.ModuleName & "',"
    lsAdd = lsAdd & "#" & format(Now,"MM/DD/YYYY hh:mm:ss") & "#)"

    'Execute the SQL
    Dbtimesheet.Execute lsAdd

    'Reassign the original values to the properties list
    RetrieveProperties

    On Error GoTo 0
    Exit Sub

NoDate_rangeAddItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeAddItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.AddItem"
        If Err = 3146 then
            objError.Message = "Date_range, AddItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, AddItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsAdd
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeAddItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     ClearValues
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method clears all fields in the Table class
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Sub ClearValues()

    Date_Id = 0
    Starting_Date = ""
    Ending_Date = ""
    Updated_By = ""
    Update_Module = ""
    Update_Time = ""

End Sub


'********************************************************************************************************
'Title:     DeleteItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method Deletes Items from the Database after the Key fields have been filled
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public Sub DeleteItem()

Dim lrsDate_range as RecordSet, lsDelete as string
Dim RetCode as integer,lsCount as integer,liCount as integer,BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeDeleteItem
    End If

    'First we assign all the properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes

    'Assemble the SQL String
    lsDelete = "Delete from DATE_RANGE  where Date_Id = " & Format(Date_Id) & ""

    'Execute the SQL
     Dbtimesheet.Execute lsDelete

    'Now ReAssign the Temp vars back to the class props
    RetrieveProperties

    On Error GoTo 0
    Exit Sub

NoDate_rangeDeleteItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeDeleteItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.DeleteItem"
        If Err = 3146 then
            objError.Message = "Date_range, DeleteItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, DeleteItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsDelete
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeDeleteItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     FillObjectFromRecordset
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose    This sub fills all the properties of the class from a given recordset
'Parameters:The recordset from which to fill
'Return:    Nothing
'********************************************************************************************************
Public Sub FillObjectFromRecordSet(lrsDate_range as RecordSet)

Dim liCount as Integer, BadCount as Integer, pSQL as String, lsSelect as String
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeFillObject
    End If

    'Appending a & "" onto the end of a recordset field checks for Null values
    'Similarly, Numbers are explicitly converted to eliminate Null values as well
    Date_Id = Val(lrsDate_range![Date_Id] & "")
    Starting_Date = lrsDate_range![Starting_Date] & ""
    Ending_Date = lrsDate_range![Ending_Date] & ""
    Updated_By = lrsDate_range![Updated_By] & ""
    Update_Module = lrsDate_range![Update_Module] & ""
    Update_Time = lrsDate_range![Update_Time] & ""
    On Error GoTo 0
    Exit Sub

NoDate_rangeFillObject:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeFillObjectConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.FillObject"
        If Err = 3146 then
            objError.Message = "Date_range, FillObject " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, FillObject "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsSelect
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeFillObjectConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     GetItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This Method Gets a record from the database after the Key Fields have been Filled
'Parameters:The recordset from which to fill
'Return:    Nothing
'********************************************************************************************************
Public Sub GetItem()

Dim lrsGetItem as RecordSet, lsSelect as string
Dim RetCode as integer,lsCount as integer,liCount as integer,BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeGetItem
    End If

    'First we assign all the properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes

    'Assemble the SQL String
    lsSelect = "Select * from DATE_RANGE  where Date_Id = " & Format(Date_Id) & ""

    'Execute the SQL
     Set lrsGetItem = Dbtimesheet.OpenRecordSet(lsSelect)

    'Now ReAssign the Temp vars back to the class props
    RetrieveProperties

    'Check for a valid record
    If Not Success Then
        Exit Sub
    End If
    If lrsGetItem.RecordCount = 0 Then
        Success = False
        Exit Sub
    End If

    'Fill the Table Class Fields from the Recordset
    FillObjectFromRecordset lrsGetItem
    'Check for Errors
    if not Success then
        Exit sub
    end if
    lrsGetItem.Close

    'Now trim the spaces out of the padded fields
    TrimPaddedFields

    'Strip the NULLs or bad dates out of date fields
    StripDates False

    On Error GoTo 0
    Exit Sub

NoDate_rangeGetItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeGetItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.GetItem"
        If Err = 3146 then
            objError.Message = "Date_range, GetItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, GetItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsSelect
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeGetItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     GetNewId
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This Method Gets a new Id using the Max function in SQL, it has only limited value, but is included as
'           a template for new Primary Key generation
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public function GetNewId() as double

Dim lrsGetNewId as RecordSet, lsSelect as string
Dim RetCode as integer,liCount as integer,BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeGetNewId
    End If

    'First we assign all the date and text properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes


    'The SQL provided here is just a simple Get Max.  This would only be useful for very small tables
    'If you anticipate this table growing past a few hundred rows, change this routine accordingly
    'You might try keeping a table with the last Id stored as a field, which can then be updated when a
    'new Id is required.

    'Assemble the SQL String
    lsSelect = "Select Max(Date_Id) from DATE_RANGE

    'Execute the SQL
    Set lrsGetNewId = Dbtimesheet.OpenRecordSet(lsSelect)

    'Now ReAssign the Temp vars back to the class props
    RetrieveProperties

    'Don't forget to check for those NULLS
    If Not IsNull(lrsGetNewId(0)) Then
        GetNewId = lrsGetNewId(0) + 1
    Else
        GetNewId = 1
    End If
    lrsGetNewId.Close
    On Error GoTo 0
    Exit Function

NoDate_rangeGetNewId:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeGetNewIdConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.GetNewId"
        If Err = 3146 then
            objError.Message = "Date_range, GetNewId " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, GetNewId "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsSelect
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeGetNewIdConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Function


'********************************************************************************************************
'Title:     ParseItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method can parse fields which have values in them.  It will create an SQL criteria string
'           using like statements for strings, and = statements for numbers and dates, this can be used
'           in Query by Example screens with little or no modification
'Parameters:None
'Return:    The Parsed String for use in SQL
'********************************************************************************************************
Public Function ParseItem(piAndFlag as Integer) As String

Dim RetCode as integer,liCount as integer,Buf1 as String
Dim BadCount as integer, WildCard As String

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeParseItem
    End If

    'Change this based on your database, MS-Access uses the *, but SQL standard is the %
    wildcard = "*'"

    'First we assign all the date and text properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields
    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes


    If Date_Id <> 0 Then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Date_range.Date_Id = " & Format(Date_Id)
        piAndFlag = True
    End If

    if isDate(Starting_Date) then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Date_range.Starting_Date = " & Starting_Date
        piAndFlag = True
    End If

    if isDate(Ending_Date) then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Date_range.Ending_Date = " & Ending_Date
        piAndFlag = True
    End If

    If Trim(Updated_By) <> "" Then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Date_range.Updated_By like '" & Trim(Updated_By) & WildCard
        piAndFlag = True
    End If

    If Trim(Update_Module) <> "" Then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Date_range.Update_Module like '" & Trim(Update_Module) & WildCard
        piAndFlag = True
    End If

    if isDate(Update_Time) then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Date_range.Update_Time = " & Update_Time
        piAndFlag = True
    End If

    'now reassign the temp values back to the properties
    RetrieveProperties

    On Error GoTo 0
    ParseItem = Buf1
    Exit Function

NoDate_rangeParseItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeParseItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.ParseItem"
        If Err = 3146 then
            objError.Message = "Date_range, ParseItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, ParseItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = Buf1
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeParseItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Function


'********************************************************************************************************
'Title:     UpdateItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method updates a record in the database using the primary key, it is recommended that you
'           Fill the Key Fields, use the get method, fill the fields which have changed,
'           then call this method to perform the update
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public Sub UpdateItem()

Dim lsUpdate as string
Dim RetCode as integer, liCount as integer, BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeUpdateItem
    End If

    'First we will assign the date properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes

    'Assemble the SQL String
    lsUpdate = "Update DATE_RANGE Set "
    lsUpdate = lsUpdate & "Starting_Date = " & Starting_Date & ","
    lsUpdate = lsUpdate & "Ending_Date = " & Ending_Date & ","
    'These are the Audit Trail Fields
    lsUpdate = lsUpdate & "Updated_By = '" & objConfiguration.LanId & "',"
    lsUpdate = lsUpdate & "Update_Module = '" & objConfiguration.ModuleName & "',"
    lsUpdate = lsUpdate & "Update_Time = #" & format(Now,"MM/DD/YYYY hh:mm:ss") & "# "
    lsUpdate = lsUpdate & " where Date_Id = " & Format(Date_Id) & ""

    'Execute the SQL
    Dbtimesheet.Execute lsUpdate

    'now reassign the temp values back to the properties
    RetrieveProperties

    On Error GoTo 0
    Exit Sub

NoDate_rangeUpdateItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeUpdateItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.UpdateItem"
        If Err = 3146 then
            objError.Message = "Date_range, UpdateItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, UpdateItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsUpdate
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeUpdateItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     DoubleYourQuotes
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine Doubles your Single Quotes in all string or memo
'           fields in the class for SQL compatibility
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub DoubleYourQuotes()

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeDoubleYourQuotes
    End If

    'These lines double the single quotes in any string field in the class
    Updated_By = SearchandDouble(Updated_By)
    Update_Module = SearchandDouble(Update_Module)
    On Error GoTo 0
    Exit Sub

NoDate_rangeDoubleYourQuotes:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeDoubleYourQuotesConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.DoubleYourQuotes"
        If Err = 3146 then
            objError.Message = "Date_range, DoubleYourQuotes " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, DoubleYourQuotes "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeDoubleYourQuotesConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     SearchandDouble
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This Function will look for any single quotes in a string passed to it
'           and double them for SQL compatibility
'Parameters:string to be modified
'Return:    the modified string
'********************************************************************************************************
Private Function SearchandDouble(lsBuf As String) As String

Dim liStrLen As Integer
Dim liCurChar As Integer
Dim liQuotePos As Integer
Dim lsQuote As String
Dim lsOutBuf As String

    lsQuote = "'"
    liCurChar = 1
    lsOutBuf = ""


    liQuotePos = InStr(liCurChar, lsBuf, lsQuote)
    If liQuotePos = 0 Then
        lsOutBuf = lsBuf
    Else
        liStrLen = Len(lsBuf)
        Do While liQuotePos > 0
            lsOutBuf = lsOutBuf & Mid(lsBuf, liCurChar, liQuotePos - liCurChar + 1) & lsQuote
            liCurChar = liQuotePos + 1
            liQuotePos = InStr(liCurChar, lsBuf, lsQuote)
        Loop
        lsOutBuf = lsOutBuf & Mid(lsBuf, liCurChar, liStrLen)
    End If

    SearchandDouble = lsOutBuf

End Function

'********************************************************************************************************
'Title:     SetDefaultDates
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine puts default date or NULL into blank or invalid date fields
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub SetDefaultDates()

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeSetDefaultDates
    End If

    'These lines look at the dates in the class, and put a NULL or your default date
     'depending on your data mode, when the date is
    'blank or invalid, since this is what sql expects
    if not isDate(Starting_Date) then
        Starting_Date = "NULL"
    Else
        Starting_Date = "#" & format(CDate(Starting_Date),"MM/DD/YYYY HH:MM:SS") & "#"
    Endif
    if not isDate(Ending_Date) then
        Ending_Date = "NULL"
    Else
        Ending_Date = "#" & format(CDate(Ending_Date),"MM/DD/YYYY HH:MM:SS") & "#"
    Endif
    if not isDate(Update_Time) then
        Update_Time = "NULL"
    Else
        Update_Time = "#" & format(CDate(Update_Time),"MM/DD/YYYY HH:MM:SS") & "#"
    Endif
    On Error GoTo 0
    Exit Sub

NoDate_rangeSetDefaultDates:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeSetDefaultDatesConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.SetDefaultDates"
        If Err = 3146 then
            objError.Message = "Date_range, SetDefaultDates " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, SetDefaultDates "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeSetDefaultDatesConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     StripDates
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine strips NULLS and bad Dates from Fields in the class, the delimiter field
'           determines whether it should check for the presence of Date Delimiters
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub StripDates(DelimiterFlag as integer)

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeStripDates
    End If

    'These lines check to see if a NULL has been entered into the field from the
    'DefaultDate subroutine, if it has, it is set to an empty string, the date from
    'the database is also checked, if it is invalid, it to is set to an empty string
    if Starting_Date = "NULL" then
        Starting_Date = ""
    Endif
    if Ending_Date = "NULL" then
        Ending_Date = ""
    Endif
    if Update_Time = "NULL" then
        Update_Time = ""
    Endif
    On Error GoTo 0
    Exit Sub

NoDate_rangeStripDates:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeStripDatesConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.StripDates"
        If Err = 3146 then
            objError.Message = "Date_range, StripDates " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, StripDates "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeStripDatesConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     PadFields
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine Pads any fields with a space which do not allow zero length
'Purpose:   The Allow zero length property is set by default in Access databases and is
'           used also in Oracle and SQLServer if the if fields are not padded with space
'           the database won't add the record, sometimes this is desirable sometimes not
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub PadFields()

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangePadFields
    End If

    'These lines put a space into any field which does not allow zero length, so the
    'record can be added anyway
    if Trim(Updated_By) = "" then
            Updated_By = " "
    Endif
    if Trim(Update_Module) = "" then
            Update_Module = " "
    Endif
    On Error GoTo 0
    Exit Sub

NoDate_rangePadFields:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangePadFieldsConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.PadFields"
        If Err = 3146 then
            objError.Message = "Date_range, PadFields " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, PadFields "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangePadFieldsConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     TrimPaddedFields
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine Trims the fields which have spaces at beginning or end
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub TrimPaddedFields()

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoDate_rangeTrimPaddedFields
    End If

    'This routine deletes the spaces from any padded fields
    Updated_By = Trim(Updated_By)
    Update_Module = Trim(Update_Module)
    On Error GoTo 0
    Exit Sub

NoDate_rangeTrimPaddedFields:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadDate_rangeTrimPaddedFieldsConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsDate_range.TrimPaddedFields"
        If Err = 3146 then
            objError.Message = "Date_range, TrimPaddedFields " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Date_range, TrimPaddedFields "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadDate_rangeTrimPaddedFieldsConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     StoreProperties
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose    This Sub Assigns the Properties of the Class to the
'           private class scratchpad variables
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub StoreProperties()

    mDate_Id = Date_Id
    mStarting_Date = Starting_Date
    mEnding_Date = Ending_Date
    mUpdated_By = Updated_By
    mUpdate_Module = Update_Module
    mUpdate_Time = Update_Time

End Sub

'********************************************************************************************************
'Title:     RetrieveProperties
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose    This Sub Assigns the ScratchPad Variable Values back to the Class properties
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub RetrieveProperties()

    Date_Id = mDate_Id
    Starting_Date = mStarting_Date
    Ending_Date = mEnding_Date
    Updated_By = mUpdated_By
    Update_Module = mUpdate_Module
    Update_Time = mUpdate_Time

End Sub